#Importo il dataset, faccio una prima pulizia e tengo i dati dagli anni 2000, degli omicidi risolti

dataset_path <- "D:/DESKTOP/Desktop/statistical learning pr/unsupervised 2/database.csv"
df <- read.csv(dataset_path)

#elimino colonne inutili
df$Record.ID <- NULL
df$Agency.Code <- NULL
df$Agency.Name <- NULL
df$Agency.Type <- NULL
df$City <- NULL
df$Victim.Ethnicity<- NULL
df$Perpetrator.Ethnicity<- NULL
df$Victim.Count<- NULL
df$Perpetrator.Count<- NULL
df$Record.Source<- NULL
df$Incident<- NULL
df$State <- NULL


df <- na.omit(df) #elimino righe con null values (df molto grande)
df <- df[!apply(df, 1, function(row) any(grepl("Unknown", row, ignore.case = TRUE))), ]
df <- df[df$Victim.Age <= 99 & df$Perpetrator.Age <= 99, ] #alcune etĆ  sono numeri inverosimili, limito a 99 anni

df <- df %>% filter(Perpetrator.Age >= 10) #tolgo casi con assassino <10 anni (involontari o falsi)
df <- df %>%
  filter(Year >= 1990)

df <- df %>%
  filter(Crime.Solved == "Yes")

df$Crime.Solved <- NULL
df$Month <- NULL
df$Year <- NULL

verifico e salvo

str(df)
## 'data.frame':    102724 obs. of  9 variables:
##  $ Crime.Type      : chr  "Murder or Manslaughter" "Manslaughter by Negligence" "Manslaughter by Negligence" "Murder or Manslaughter" ...
##  $ Victim.Sex      : chr  "Female" "Male" "Male" "Male" ...
##  $ Victim.Age      : int  25 1 0 32 30 2 21 33 3 3 ...
##  $ Victim.Race     : chr  "Black" "Asian/Pacific Islander" "Asian/Pacific Islander" "White" ...
##  $ Perpetrator.Sex : chr  "Male" "Male" "Female" "Male" ...
##  $ Perpetrator.Age : int  28 12 39 39 20 20 21 20 19 23 ...
##  $ Perpetrator.Race: chr  "Black" "Asian/Pacific Islander" "Asian/Pacific Islander" "White" ...
##  $ Relationship    : chr  "Wife" "Family" "Acquaintance" "Stranger" ...
##  $ Weapon          : chr  "Handgun" "Blunt Object" "Blunt Object" "Rifle" ...
##  - attr(*, "na.action")= 'omit' Named int 232235
##   ..- attr(*, "names")= chr "232235"
output_path <- "D:/DESKTOP/Desktop/statistical learning pr/unsupervised 2/dfsolved.csv"
write.csv(df, output_path, row.names = FALSE)

#EXPLORATORY DATA A ##studio qualche dato interessante per comprendere il dataset, partendo dalla distribuzione delle etĆ  killer/vittime

par(mfrow = c(1, 2))

#Victim age
qqnorm(df$Victim.Age, main = "QQ Plot - Victim Age", col = "steelblue")
qqline(df$Victim.Age, col = "red")

#perpetrator age
qqnorm(df$Perpetrator.Age, main = "QQ Plot - Perpetrator Age", col = "darkgreen")
qqline(df$Perpetrator.Age, col = "red")

par(mfrow = c(1, 1)) #resetto

##creo nuova colonna che mostra rapporto tra vittima e killer, per vedere distribuzioni omicidi su sesso

df$Combinazione <- paste(df$Perpetrator.Sex, "/", df$Victim.Sex)


tabella_sex <- df %>%
  count(Combinazione) %>%
  arrange(desc(n)) %>%
  mutate(Percentuale = round(n / sum(n) * 100, 1))

colnames(tabella_sex)[1] <- "Perpetrator / Victim SEX"
colnames(tabella_sex)[2] <- "n tot"
colnames(tabella_sex)[3] <- "% of total" 
tabella_sex
##   Perpetrator / Victim SEX n tot % of total
## 1              Male / Male 64471       62.8
## 2            Male / Female 27512       26.8
## 3            Female / Male  8063        7.8
## 4          Female / Female  2678        2.6
ggplot(tabella_sex, aes(x = "", y = `% of total`, fill = `Perpetrator / Victim SEX`)) +
  geom_col(width = 1, color = "white") +
  coord_polar(theta = "y") +
  theme_void() +
  labs(title ="Distribution of kills by sex", fill ="Combination") +
  geom_text(aes(label =paste0(`% of total`, "%")),
            position = position_stack(vjust= 0.5),
            color = "white", size =4)

df$Combinazione<-NULL
#qua creo una funzione per raggruppare le principali relazioni tra killer e vittima

classifica_relazione <- function(x) {
  x <- tolower(x)
  if (x %in% c("husband", "wife", "ex-husband", "ex-wife", "boyfriend", "girlfriend", "boyfriend/girlfriend", "common-law husband", "common-law wife")) {return("Partner/Ex Partner")} 
  
  else if (x %in% c("family", "father", "mother", "daughter", "son", "sister", "brother", "stepfather", "stepmother", "stepdaughter", "stepson", "in-law")) {return("Family")} 
  
  else if (x == "friend") {return("Friend")} 
  else if (x == "acquaintance") { return("Acquaintance")} 
  else if (x == "stranger") {return("Stranger")} 
  else {return("Other")}}


df$Relazione_Semplificata <- sapply(df$Relationship, classifica_relazione) #applico sul df

#sno interessato a trovare la statistica diversa per maschi e femmine dunque divido i dati per sesso
maschi <- df[df$Perpetrator.Sex == "Male", ]
femmine <- df[df$Perpetrator.Sex == "Female", ]



#funzione per creare tabella e tenere solo le prime 5 categorie
pie_data <- function(dati) {
  tab <-  as.data.frame(table(dati$Relazione_Semplificata))
  colnames(tab)<- c("Relazione", "Frequenza")
  tab <-tab[order(-tab$Frequenza), ]
  tab <- head(tab, 5)
  tab$Percentuale <-  round(tab$Frequenza /sum(tab$Frequenza)* 100, 1)
  return(tab)}

rel_maschi <- pie_data(maschi)
rel_femmine <- pie_data(femmine)

#torta maschi
ggplot(rel_maschi, aes(x = "", y = Percentuale, fill = Relazione)) +
  geom_col(width = 1, color = "white") +
  coord_polar("y") +
  theme_void() +
  labs(title = "Male- relationship with victim (top 5)") +
  geom_text(aes(label = paste0(Percentuale, "%")),
            position = position_stack(vjust = 0.5), color = "white", size = 4)

#torta femmine
ggplot(rel_femmine, aes(x = "", y = Percentuale, fill = Relazione)) +
  geom_col(width = 1, color = "white") +
  coord_polar("y") +
  theme_void() +
  labs(title = "Female - Relationship with victim (top 5)") +
  geom_text(aes(label = paste0(Percentuale, "%")),
            position = position_stack(vjust = 0.5), color = "white", size = 4)

df$Relazione_Semplificata<-NULL

#VARIABLES TRASFORMATIONS inizio a trasformare le variabili categoriche in numeriche per PCA e clustering

##parto dalle piu semplici (dummy)

#volontario =1, non volontario =0
df$Crime.Type <-ifelse(grepl("Murder", df$Crime.Type), 1, 0)

#Victim.Sex (0 = male, 1 = fem)
df$Victim.Sex <-ifelse(df$Victim.Sex == "Female", 1, 0)

#Perpetrator.Sex (0 = maschio, 1 = femm)
df$Perpetrator.Sex <-ifelse(df$Perpetrator.Sex== "Female", 1, 0)

#Weapon (Arma da fuoco = 1, resto = 0)
df$Weapon <-ifelse(grepl("Handgun|Shotgun|Rifle|Firearm", df$Weapon),1, 0)

##variabile Relationship divido i casi di omicidi tra relazioni con la vittima ā€œstretteā€ (0) e non (1)

table(df$Relationship)
## 
##         Acquaintance            Boyfriend Boyfriend/Girlfriend 
##                31827                 2226                  344 
##              Brother   Common-Law Husband      Common-Law Wife 
##                 1478                  218                  566 
##             Daughter             Employee             Employer 
##                 2396                  104                  154 
##           Ex-Husband              Ex-Wife               Family 
##                  125                  624                 3410 
##               Father               Friend           Girlfriend 
##                 1492                 5515                 6526 
##              Husband               In-Law               Mother 
##                 1649                  856                 1625 
##             Neighbor               Sister                  Son 
##                 1644                  380                 3119 
##         Stepdaughter           Stepfather           Stepmother 
##                  280                  398                   61 
##              Stepson             Stranger                 Wife 
##                  394                27460                 7853
contatti_non_stretti <- c("Stranger", "Acquaintance", "Employee", "Employer")

#Dummy: 1 = NON contatto stretto, 0 = contatto stretto
df$Rel_NotClose <- ifelse(df$Relationship %in% contatti_non_stretti, 1, 0)

table(df$Rel_NotClose)
## 
##     0     1 
## 43179 59545
df$Relationship<-NULL

##variabile ā€œraceā€ semplifico le due colonne di variabili in un unica dummy casi in cui killer e vittima hanno la stessa etnia (1), e casi in cui ĆØ diversa(0)

df$Victim.Race <- tolower(df$Victim.Race)
df$Perpetrator.Race <-tolower(df$Perpetrator.Race)

df$Same_Race<- ifelse(df$Victim.Race == df$Perpetrator.Race, 1, 0)

df$Victim.Race <- NULL
df$Perpetrator.Race <- NULL

##check finale

str(df)
## 'data.frame':    102724 obs. of  8 variables:
##  $ Crime.Type     : num  1 0 0 1 1 1 1 1 0 0 ...
##  $ Victim.Sex     : num  1 0 0 0 0 0 0 1 0 0 ...
##  $ Victim.Age     : int  25 1 0 32 30 2 21 33 3 3 ...
##  $ Perpetrator.Sex: num  0 0 1 0 0 0 0 0 0 1 ...
##  $ Perpetrator.Age: int  28 12 39 39 20 20 21 20 19 23 ...
##  $ Weapon         : num  1 0 0 1 1 0 1 0 0 0 ...
##  $ Rel_NotClose   : num  0 0 1 1 1 1 1 1 1 0 ...
##  $ Same_Race      : num  1 1 1 1 1 1 0 0 0 1 ...
##  - attr(*, "na.action")= 'omit' Named int 232235
##   ..- attr(*, "names")= chr "232235"

#PCA

df_scaled <-scale(df) #scalo tutte le variabili standardizzandole

pca_result<- prcomp(df_scaled, center = TRUE, scale. = TRUE)

#Scree plot: percentuale di varianza spiegata da ciascun componente
pca_var <- pca_result$sdev^2
pca_var_perc <-round(pca_var / sum(pca_var) * 100, 1) 

barplot(pca_var_perc,
        main = "Scree Plot - PCA",
        xlab ="Principal Component",
        ylab = "Percentuale di varianza spiegata",
        names.arg = paste0("PC", 1:length(pca_var_perc)),
        col = "lightblue")

#creo dataset con le principal components
pca_df <-as.data.frame(pca_result$x)
pca_df$Cluster <- NA  # inizialmente nessun cluster assegnato

#loadings sono le direzioni delle variabili originali
loadings<- as.data.frame(pca_result$rotation[, 1:2])
loadings$Variable <- rownames(loadings)

#Visualizzazione PCA con frecce
library(ggplot2)
library(grid)  # per freccia

ggplot(pca_df, aes(x =PC1, y= PC2)) +
  geom_point(alpha = 0.4, color = "steelblue") +
  geom_segment(data=loadings, aes(x = 0, y = 0, xend = PC1* 5, yend=PC2 * 5), arrow = arrow(length=unit(0.2, "cm")), color= "darkred", size = 0.8) +
  geom_text(data = loadings,
            aes(x =PC1 * 5.5, y =PC2 * 5.5, label = Variable),
            color ="darkred", size= 4) +
  theme_minimal() +
  labs(title = "Biplot PCA con frecce (loadings)",
       x = paste0("PC1 (",pca_var_perc[1],"%)"),
       y = paste0("PC2 (", pca_var_perc[2], "%)"))

round(pca_result$rotation[,1:2], 2)
##                   PC1   PC2
## Crime.Type       0.00 -0.39
## Victim.Sex      -0.47  0.04
## Victim.Age      -0.34 -0.53
## Perpetrator.Sex -0.20  0.43
## Perpetrator.Age -0.48 -0.40
## Weapon           0.27 -0.33
## Rel_NotClose     0.54 -0.27
## Same_Race       -0.19  0.19

#ELBOW PLOT per capire quanti n clusters usare

wss <- numeric(10)

for (k in 1:10) {
  kmeans_result<- kmeans(pca_df[, 1:2], centers= k, nstart = 25)
  wss[k] <-kmeans_result$tot.withinss
}

plot(1:10, wss, type = "b", pch = 19,
     xlab = "n cluster",
     ylab = "WSS",
     main = "Elbow Plot")

#KMEANS 3 clusters

set.seed(123)

#tengo 3 kluster secondo elbow plot.. applico
kmeans_result <- kmeans(pca_df[, 1:2], centers = 3, nstart = 25, iter.max = 100)
pca_df$Cluster <- as.factor(kmeans_result$cluster)

#attenzione: metto i cluster in formato numerico (serve dopo per silhouette)
cluster_kmeans <- as.numeric(pca_df$Cluster)

#grafico 2D
library(ggplot2)

ggplot(pca_df, aes(x = PC1, y= PC2, color = Cluster)) +
  geom_point(alpha = 0.6) +
  theme_minimal() +
  labs(title = "Cluster K-means (k = 3) sulla PCA",
       x = paste0("PC1(", pca_var_perc[1], "%)"),
       y =paste0("PC2 (", pca_var_perc[2],"%)"),
       color ="Cluster")

##3D plot per aiutarci nella comprensione e divisione visiva

#grafico imn 3D con plotly
plot_ly(pca_df, x = ~PC1, y = ~PC2,z = ~PC3,
        color = ~Cluster, colors = c("tomato", "steelblue", "darkgreen"),
        type ="scatter3d", mode = "markers",marker=list(size=1)) %>%
  layout(title = "K-means clustering in 3D (PC1-PC2-PC3)",
         scene = list(
           xaxis = list(title = paste0("PC1 (", pca_var_perc[1], "%)")),
           yaxis = list(title = paste0("PC2 (", pca_var_perc[2], "%)")),
           zaxis = list(title = paste0("PC3 (", pca_var_perc[3], "%)"))
         ))
#noto un gruppetto di outliers.. provvedo dopo ad indagare a che variabili sono dovuti

##analizzo le caratteristiche medie per ogni cluster! per comprendere le differenze effettive

#unisco i cluster al dataframe originale
df_clustered <- cbind(df, Cluster = pca_df$Cluster)

# Calcolo statistiche medie per ogni cluster.. ANALISI INDISPENSABILE per capire le caratteristiche principali di 3 tipi di omicidio!!
df_clustered %>%
  group_by(Cluster) %>%
  summarise(
    Count = n(),
    EtĆ _media_vittima = round(mean(Victim.Age), 1),
    EtĆ _media_colpevole = round(mean(Perpetrator.Age), 1),
    Percent_donne_vittime = round(mean(Victim.Sex == 1) * 100, 1),
    Percent_donne_colpevoli = round(mean(Perpetrator.Sex == 1) * 100, 1),
    Percent_arma_fuoco = round(mean(Weapon == 1) * 100, 1),
    Percent_rel_non_stretta = round(mean(Rel_NotClose == 1) * 100, 1),
    Percent_same_race = round(mean(Same_Race == 1) * 100, 1)
  )
## # A tibble: 3 Ɨ 9
##   Cluster Count EtĆ _media_vittima EtĆ _media_colpevole Percent_donne_vittime
##   <fct>   <int>             <dbl>               <dbl>                 <dbl>
## 1 1       56377              30.8                27.2                   6.2
## 2 2       18560              21.5                27.6                  45.6
## 3 3       27787              50.3                45.9                  65.5
## # ℹ 4 more variables: Percent_donne_colpevoli <dbl>, Percent_arma_fuoco <dbl>,
## #   Percent_rel_non_stretta <dbl>, Percent_same_race <dbl>

##Silhouette analisi

set.seed(123)
sample_idx <- sample(nrow(pca_df), 10000)
pca_small <- pca_df[sample_idx, 1:2]
cluster_small <- as.numeric(pca_df$Cluster[sample_idx])

#istanza e silhouette
dist_small <- dist(pca_small)
sil <- silhouette(cluster_small, dist_small)


fviz_silhouette(sil) #grafico
##   cluster size ave.sil.width
## 1       1 5421          0.55
## 2       2 1838          0.35
## 3       3 2741          0.38

##extra: provo a fare una cosa interessante individo gli outlier rispetto ai cluster trovati, ovvero i punti con silhouette negativa. Questo per comprendere la parte di dati che si distribuisce più distante dai centroidi, non adattandosi bene ai klusters

#subset usato per la silhouette
set.seed(123)
sample_idx <- sample(nrow(pca_df), 10000)
pca_small <- pca_df[sample_idx, 1:2]
cluster_small <- as.numeric(pca_df$Cluster[sample_idx])


sil_df <- as.data.frame(sil) #lo trasformo in df

#ATTENZIONE.. prendo solo le distanze negative, per risalire alle variabili iniziali che danno "problemi"
outliers <- sil_df %>% filter(sil_width < 0)

#recupero i dati originali collegati a tali valori
outlier_idx <- as.integer(rownames(outliers))
dati_outlier <- df_clustered[sample_idx[outlier_idx], ]

dati_outlier
##        Crime.Type Victim.Sex Victim.Age Perpetrator.Sex Perpetrator.Age Weapon
## 51663           1          0         27               0              18      1
## 57870           1          0         21               0              22      1
## 2986            1          0         22               1              25      1
## 29925           1          0         56               0              24      1
## 95246           1          0         16               0              16      1
## 68293           1          0         43               0              20      0
## 62555           1          0         23               0              26      0
## 45404           1          1         44               0              44      1
## 65161           1          0         40               0              56      1
## 46435           1          0         46               0              28      1
## 9642            1          0         52               0              26      0
## 59134           1          1         23               0              30      1
## 52132           1          0         24               0              22      1
## 96849           0          0          2               0              77      1
## 14183           1          0         19               0              20      0
## 15180           1          0         22               0              30      1
## 27168           1          0         37               0              23      1
## 89709           1          1         31               0              38      1
## 9097            1          0         53               1              51      0
## 30538           1          0         35               0              23      1
## 56219           1          1         50               0              17      1
## 94517           1          0         40               0              25      1
## 7989            1          1         44               0              14      0
## 13536           1          1         33               1              37      0
## 90077           1          0         55               0              44      1
## 6216            1          0         24               0              22      1
## 83519           1          0         29               0              24      1
## 29394           1          1          1               1              20      0
## 53241           1          0         31               0              21      0
## 28825           1          0         22               0              39      0
## 41              1          0         24               0              45      1
## 14426           1          0         22               0              24      1
## 72820           1          1         75               0              91      1
## 51656           1          0         22               0              25      1
## 94038           1          0         21               0              55      0
## 58527           1          0         26               0              27      0
## 77009           1          0         29               0              25      1
## 43042           1          0         41               1              48      1
## 77837           1          0         21               0              24      1
## 6134            1          1          5               0              28      1
## 33523           1          1         31               0              48      0
## 21812           1          0         22               0              21      1
## 39895           1          1         34               0              35      0
## 9640            1          0          0               0              28      0
## 85278           1          0         32               0              33      1
## 9326            1          1         22               0              28      1
## 26510           1          0         20               0              21      1
## 20960           1          0         33               0              35      1
## 14403           1          0         26               0              23      1
## 64502           1          0         29               0              36      1
## 71503           1          1         38               0              60      1
## 45221           1          1         57               0              61      1
## 94335           1          0         28               0              50      0
## 92372           1          1         19               0              26      1
## 77585           1          0         33               0              33      1
## 80686           1          0         17               0              18      0
## 70563           1          1         53               0              47      0
## 32606           1          0         45               0              62      1
## 16152           1          0         20               0              21      1
## 25559           1          0         42               0              28      1
## 14215           1          1          5               1              33      0
## 14287           1          0         75               1              67      0
## 23194           1          0         49               0              23      1
## 90094           1          0         28               0              19      1
## 34976           1          0         16               0              13      1
## 14491           1          0         31               0              39      1
## 82949           1          0         30               0              19      1
## 77584           1          0          3               0              24      0
## 40503           1          1         49               0              57      1
## 34724           1          0         44               0              25      1
## 86013           1          0         34               0              25      1
## 17369           1          0         75               0              18      1
## 31542           1          1         54               0              58      0
## 102537          1          0         34               0              48      1
## 59106           1          0         77               0              27      1
## 86605           1          0         26               0              19      1
## 40632           1          0         50               0              19      1
## 96111           1          0         22               0              21      1
## 43204           1          1         21               0              28      1
## 37544           1          1         52               0              34      0
## 99289           1          0          1               1              19      0
## 84427           1          0         27               0              64      0
## 76820           1          0         20               0              19      0
## 82115           1          0         51               1              39      0
## 44196           1          0         20               0              22      1
## 92337           1          1         14               0              19      0
## 44983           1          0         17               0              18      0
## 91438           1          0         32               1              52      1
## 36717           1          0         85               0              35      0
## 28078           1          0         41               1              16      0
## 69369           1          0         65               0              33      0
## 91564           1          0         45               0              52      1
## 43406           1          0         35               0              34      1
## 41488           1          1         35               0              41      0
## 47485           1          0         20               0              30      1
## 63528           1          1         78               0              50      0
## 14536           1          0         19               0              19      1
## 83069           1          0         36               0              46      1
## 51465           1          1         19               0              22      1
## 26503           1          1          0               0              26      0
## 88299           1          0         29               0              33      0
## 32953           1          1         29               0              32      0
## 413             1          0         39               0              39      0
## 10762           1          1          2               0              23      0
## 48182           1          1         28               0              25      1
## 30571           1          1         79               0              59      0
## 42521           1          0         63               0              16      1
## 74522           1          1         46               1              33      0
## 14745           1          1         30               0              16      1
## 25946           1          0         60               0              17      1
## 80340           1          0         17               0              30      0
## 43928           1          0         36               0              41      0
## 6601            1          0         23               0              19      1
## 57701           1          0         44               0              45      1
## 53518           1          1         33               0              28      0
## 72326           1          0         35               0              17      1
## 52353           1          0         28               0              55      1
## 66154           1          0         35               0              26      0
## 47802           1          0         37               0              17      1
## 31517           1          1         12               0              36      0
## 66075           1          0         26               1              24      0
## 32263           1          0          2               0              35      0
## 95989           1          0         16               0              14      0
## 69161           1          0         45               0              20      1
## 81118           1          0         20               0              48      1
## 56157           1          0         42               0              25      1
##        Rel_NotClose Same_Race Cluster
## 51663             1         0       1
## 57870             1         1       1
## 2986              0         1       2
## 29925             1         1       1
## 95246             0         1       1
## 68293             1         1       1
## 62555             1         1       1
## 45404             0         1       3
## 65161             1         0       1
## 46435             0         1       1
## 9642              1         1       1
## 59134             0         1       3
## 52132             1         0       1
## 96849             1         1       2
## 14183             1         1       1
## 15180             1         0       1
## 27168             1         1       1
## 89709             1         1       1
## 9097              0         1       3
## 30538             0         1       1
## 56219             1         1       1
## 94517             1         1       1
## 7989              1         0       1
## 13536             0         1       2
## 90077             1         0       1
## 6216              1         1       1
## 83519             1         0       1
## 29394             0         1       2
## 53241             1         0       1
## 28825             0         1       2
## 41                1         1       1
## 14426             1         1       1
## 72820             0         1       3
## 51656             1         1       1
## 94038             1         1       1
## 58527             1         1       1
## 77009             1         1       1
## 43042             0         1       3
## 77837             1         1       1
## 6134              0         1       2
## 33523             0         1       3
## 21812             1         0       1
## 39895             0         1       3
## 9640              0         1       2
## 85278             0         1       1
## 9326              0         1       2
## 26510             1         1       1
## 20960             1         1       1
## 14403             1         1       1
## 64502             1         0       1
## 71503             1         1       3
## 45221             0         1       3
## 94335             0         1       3
## 92372             1         0       1
## 77585             1         1       1
## 80686             0         0       1
## 70563             0         1       3
## 32606             1         1       3
## 16152             1         1       1
## 25559             1         1       1
## 14215             0         1       2
## 14287             0         1       3
## 23194             1         0       1
## 90094             1         1       1
## 34976             0         1       1
## 14491             1         1       1
## 82949             1         1       1
## 77584             0         1       2
## 40503             0         1       3
## 34724             1         1       1
## 86013             1         1       1
## 17369             1         1       1
## 31542             1         0       3
## 102537            1         1       1
## 59106             1         0       1
## 86605             1         1       1
## 40632             1         0       1
## 96111             1         1       1
## 43204             0         1       2
## 37544             1         1       3
## 99289             0         1       2
## 84427             0         1       3
## 76820             1         1       1
## 82115             0         1       2
## 44196             1         1       1
## 92337             1         1       2
## 44983             1         1       1
## 91438             1         0       1
## 36717             1         1       3
## 28078             1         1       2
## 69369             1         1       1
## 91564             1         1       1
## 43406             0         1       1
## 41488             0         1       3
## 47485             1         1       1
## 63528             0         1       3
## 14536             1         1       1
## 83069             1         1       1
## 51465             1         1       1
## 26503             0         1       2
## 88299             1         1       1
## 32953             1         0       1
## 413               0         1       3
## 10762             1         1       2
## 48182             0         1       2
## 30571             0         1       3
## 42521             1         1       1
## 74522             1         1       2
## 14745             1         1       1
## 25946             1         1       1
## 80340             1         1       1
## 43928             0         1       3
## 6601              1         0       1
## 57701             1         1       1
## 53518             0         1       2
## 72326             0         1       1
## 52353             1         1       1
## 66154             0         1       2
## 47802             1         0       1
## 31517             0         1       2
## 66075             0         1       2
## 32263             0         1       2
## 95989             1         1       1
## 69161             0         1       1
## 81118             1         1       1
## 56157             1         0       1

#CLUSTERING GERARCHICO tecnica alternativa al k-means

set.seed(123)
sample_idx <- sample(nrow(pca_df), 10000)  #subset per alleggerire i calcoli

pca_subset<- pca_df[sample_idx, 1:2]  #uso solo i primi due componenti

#calcolo distanzA euclidea tra i punti
dist_hc <-dist(pca_subset)

hc<- hclust(dist_hc, method = "ward.D2") #algoritmo gerarchico ward.D2 = cerca di minimizzare varianza interna

plot(hc, labels= FALSE, hang =-1, main = "Dendrogramma - Hierarchical Clustering")


#evidenzio a mano i cluster (k=3 come prima) e assegno i cluster trovati
rect.hclust(hc, k = 3, border= 2:4)

hc_clusters<- cutree(hc, k = 3)

#confronto finale

#cluster da k-means sullo stesso sample usato per l'hierarchical
kmeans_sample <-as.numeric(pca_df$Cluster[sample_idx])

#tabella confronto
table(kmeans_sample, hc_clusters)
##              hc_clusters
## kmeans_sample    1    2    3
##             1 5399   22    0
##             2   46 1787    5
##             3  712  567 1462